home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
turbovis
/
tvtoys04.zip
/
MODEDLG.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-12-15
|
12KB
|
400 lines
(***************************************************************************
ModeDialog unit
A dialog displaying available video modes, supporting routines
PJB August 30, 1993, Internet mail to d91-pbr@nada.kth.se
Copyright PJB 1993, All Rights Reserved.
Free source, use at your own risk.
If modified, please state so if you pass this around.
If you want to omit certain video modes from the list, change the
AddMode procedure to include a test (e.g. if Columns<80 then Exit...)
Turbo Vision works in 40 columns, but the SelectVideoMode dialog does
not (it is too wide, selecting Preview will shrink the dialog).
You can overlay this unit and put TSelectVideoModeDialog in a
resource file. Here is what to do with a resource file:
SetupVideoList;
SelectVideoMode(PSelectVideoModeDialog(RezFile.Get('VideoModeDialog')));
See VIDEOTST.PAS for a demonstration of this unit.
***************************************************************************)
unit ModeDlg;
{$I toyCfg}
{$B-,O+,Q-,T-,X+}
interface
uses
App, Dialogs, Drivers, Objects, Memory, MsgBox, Views,
toyPrefs, {$I hcFile}
TVVideo, Video;
type
PSelectVideoModeDialog = ^TSelectVideoModeDialog;
TSelectVideoModeDialog =
object (TDialog)
VideoListBox : PListBox;
constructor Init;
constructor Load(var S:TStream);
procedure HandleEvent(var Event:TEvent); virtual;
procedure Store(var S:TStream);
end;
procedure StoreVideoModes(var S:TStream);
procedure LoadVideoModes(var S:TStream);
procedure Delay(Ticks:word);
procedure SetupVideoList;
function HasToScan:Boolean;
procedure SelectVideoModeDialog;
procedure SelectVideoMode(P:PSelectVideoModeDialog);
var
(* SelectVideoModeDialog GetData/SetData operates on this *)
VideoModeDataRec :
record
VideoListBox : TListboxRec;
end;
(* The ModeList array contains the actual video modes
corresponding to the entries in the VideoList listbox *)
ModeList : array [0..MaxVideoModes] of Word;
{$IFDEF StoreModeData}
type
ModeDataRec =
record
Columns : Byte;
Rows : Byte;
CharHeight : Byte;
Color : Boolean;
end;
var
(* The ModeDataList array contains each video mode's
width, height and character size for matching purposes *)
ModeDataList : array [0..MaxVideoModes] of ModeDataRec;
function FindSimilarVideoMode(Columns, Rows:Byte; Color:Boolean):Word;
{$ENDIF}
(***************************************************************************
***************************************************************************)
implementation
var
(* AddMode adds new lines of video mode information to VideoList *)
VideoList : PStringCollection;
(*******************************************************************
These routines save mode information on a stream. They are meant
to be used with an init or configuration file
*******************************************************************)
procedure StoreVideoModes;
begin
S.Put(VideoList);
S.Write(ModeList, SizeOf(ModeList));
{$IFDEF StoreModeData}
S.Write(ModeDataList, SizeOf(ModeDataList));
{$ENDIF}
end;
procedure LoadVideoModes;
begin
VideoList:=PStringCollection(S.Get);
S.Read(ModeList, SizeOf(ModeList));
{$IFDEF StoreModeData}
S.Read(ModeDataList, SizeOf(ModeDataList));
{$ENDIF}
end;
(*******************************************************************
Delay for Ticks 18ths of a second, calling Idle
*******************************************************************)
procedure Delay(Ticks:word);
var
Finish : Word;
begin
Finish:=MemW[Seg0040:$6C]+Ticks;
while Finish-MemW[Seg0040:$6C]<=Ticks do
Application^.Idle;
end;
{$IFDEF StoreModeData}
(*******************************************************************
Simple example of how to find a reasonably similar video mode
Tries to weigh Width and Height differently.
*******************************************************************)
function FindSimilarVideoMode(Columns, Rows:Byte; Color:Boolean):Word;
var
Diff : Word;
OldDiff : Word;
i : Integer;
begin
FindSimilarVideoMode:=ScreenMode;
OldDiff:=999;
for i:=0 to VideoList^.Count-1 do
begin
Diff:=Abs(ModeDataList[i].Rows-Rows)+
Abs(ModeDataList[i].Columns-Columns) div 2+
20*Ord(ModeDataList[i].Color<>Color);
if Diff<OldDiff then
begin
OldDiff:=Diff;
FindSimilarVideoMode:=ModeList[i];
end;
end;
end;
{$ENDIF}
(*******************************************************************
This procedure will be called by Video.ScanEVGAModes with
new mode information.
*******************************************************************)
procedure AddMode(Mode, Rows, Columns, CharHeight:Word; Color:boolean); far;
const
ColorStr : string[5] = 'color';
MonoStr : string[4] = 'mono';
BWStr : string[3] = 'b/w';
var
Params : array [0..4] of Longint;
Line : String;
i : Integer;
begin
if (Columns>=80) and (VideoList^.Count<=MaxVideoModes) then
begin
Params[0]:=Mode;
Params[1]:=Columns;
Params[2]:=Rows;
Params[3]:=CharHeight;
if Mode=smBW80 then
Params[4]:=LongInt(@BWStr)
else
if Color then
Params[4]:=LongInt(@ColorStr)
else
Params[4]:=LongInt(@MonoStr);
FormatStr(Line, '%3xh %3dx%-2d %2dp %s', Params);
i:=VideoList^.Count;
ModeList[i]:=Mode;
{$IFDEF StoreModeData}
ModeDataList[i].Columns:=Columns;
ModeDataList[i].Rows:=Rows;
ModeDataList[i].CharHeight:=CharHeight;
ModeDataList[i].Color:=Color;
{$ENDIF}
VideoList^.Insert(NewStr(Line));
end;
end;
(*******************************************************************
Scan for video modes and add to VideoList
*******************************************************************)
procedure SetupVideoList;
begin
if VideoList=Nil then (* Check for previous list... *)
begin
New(VideoList, Init(20,10));
{$IFDEF VesaSupport}
if VESA.VesaScanningPossible then
begin
(************************************************************
Add standard modes if necessary, Marek Bojarski's idea
************************************************************)
if not VESA.StandardInfoAvailable then
begin
HideMouse;
ScanEVGAModes(0, StandardTextModes, AddMode);
SetSpecialScreenMode(ScreenMode);
ShowMouse;
end;
VESA.ScanVesaModes(AddMode)
end
else
{$ENDIF}
begin
HideMouse;
ScanEVGAModes(0, VGAModes, AddMode);
{$IFDEF VesaSupport} (* If not VesaScanningPossible *)
if VESA.VesaVersion<>0 then
ScanEVGAModes($100, VESAModes, AddMode);
{$ENDIF}
(* Restore Turbo Vision screen *)
SetSpecialScreenMode(ScreenMode);
ShowMouse;
end;
end;
VideoModeDataRec.VideoListBox.List:=VideoList;
end;
(*******************************************************************
Return True if there is no previous list of video modes
*******************************************************************)
function HasToScan:Boolean;
begin
HasToScan:=VideoList=Nil;
end;
(*******************************************************************
Let the user select a video mode
*******************************************************************)
procedure SelectVideoModeDialog;
begin
SelectVideoMode(New(PSelectVideoModeDialog, Init));
end;
(*****************************************